perm filename FILER[AP,SYS]2 blob
sn#012210 filedate 1972-11-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00020 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 Definitions.
C00006 00003 Storage allocations.
C00010 00004 Start of main program (FILER).
C00014 00005 Run INITER on a pty.
C00015 00006 Create NEWS and INDEX files.
C00018 00007
C00019 00008 Search for beginning of story. Then collect entire story.
C00022 00009 Prepare to write out newly read story.
C00025 00010 See how many (if any) old stories must be deleted to fit the new story in.
C00027 00011 Update INDEX file.
C00030 00012 Write out new story.
C00033 00013 Subroutines: ERROR.
C00035 00014 Subroutines: ERROR (cont'd).
C00038 00015 Subroutines: GETCH,CHGNAM,INTRPT.
C00042 00016 Subroutines: DELOLD.
C00047 00017 Subroutines: SNDHOT,PROCRQ,GOAWAY.
C00051 00018 Conversion table for unshifted characters. Setting and clearing shift flag (SHFTFG).
C00054 00019 UPPER: JRST GETCH 0: tape feed
C00057 00020 Conversion code for special characters.
C00060 ENDMK
C⊗;
;Definitions.
TITLE FILER
; ACCUMULATOR ASSIGNMENTS
FLG←←0 ;AC with flags in LH and zero (for IDPBs) in RH
A←1 ;temporary AC
B←2 ;temporary AC
C←3 ;temporary AC
SLOT←4 ;pointer to the current slot in LINKS
SIZE←5 ;size of new story
TXTLEN←6 ;length of the text (in words) to be written out
STORY←7 ;saved byte pointer to first word in buffer for new story
D←←7 ;temporary AC
CHAR←←10 ;current character in the current story
E←←10 ;temporary AC
FST←10 ;pointer to first word of area to contain new story
CNT←←11 ;counter for digits in sequence nbrs and for LFs at end of story
NXT←11 ;pointer to first word afterarea to contain new story
BCNT←12 ;counter of bytes in buffer
BPTR←13 ;byte pointer into buffer holding current story
AC1←←14 ;temporary AC
AC2←←15 ;temporary AC
UNDUN←14 ;index of first uncatalogued story
NEW←15 ;index of area for next story
OLD←16 ;index of oldest story
P←17 ;pdl pointer
LF←←12 CR←←15
SPECS←←4 ;number of special words at front of INDEX file
XSIZE←←3 ;size of the index entry for one story
MAXNBR←=500 ;maximum number of stories allowed
XLEN←MAXNBR*XSIZE+SPECS ;length of INDEX file
MAXK←←=58 ;maximum size of NEWS file in K
RECLMT←←MAXK*=8+1 ;number of record one beyond allowable rec. in NEWS file
BLEN←←2200
LLEN←←10000
DLEN←←200
PDLEN←←5 ;length of the pdl
EXTERNAL JOBAPR,JOBCNI
;Here are some flag bits for the left half of AC FLG
;(there are no flags defined yet.)
DEFINE ERRMSG(MSG)
{PUSHJ P,[ MOVEM A,SAVEDA
MOVEI A,[ASCIZ \ FILER: MSG
\]
JRST ERROR]}
;Storage allocations.
NEWSF: SIXBIT /NEWS/ ;block for LOOKUP and ENTER for NEWS file
BLOCK 3
INDEXF: SIXBIT /INDEX/ ;block for LOOKUP and ENTER for INDEX file
BLOCK 3
LINKSF: SIXBIT /LINKS/
BLOCK 3
DICTF: SIXBIT /DICT/
BLOCK 3
ERRORF: SIXBIT /ERRORS/
BLOCK 3
BUF: BLOCK BLEN ;buffer to hold stories
INDEX: BLOCK XLEN ;core array for holding index pointers for stories
LINKS: BLOCK LLEN
DICT: BLOCK DLEN
IBUF: BLOCK 3 ;buffer header for buffers holding characters from AP line
ERRBFI: BLOCK 3 ;buffer header for input buffer for copying old error msgs
ERRBFO: BLOCK 3 ;buffer header for output buffer for writing error msgs
INLTR: BLOCK =32 ;block for holding letter received (from HOT)
PDLIST: BLOCK PDLEN ;area for stack
CMD: IOWD 1,BUF ;dump mode command list for outputting stories
0
XCMD: IOWD XLEN,INDEX ;dump mode command for reading/writing INDEX file
0
LCMD: IOWD LLEN,LINKS
0
DCMD: IOWD DLEN,DICT
0
DSK17: 17 ;block used for opening the dsk in mode 17 many times
SIXBIT /DSK/
0
SPL: SIXBIT /DSK/
SIXBIT /SPL/
XWD 'DMP',14 ;start up SPL on another job and dont set JLOG
0
SIXBIT / APSYS/
SIXBIT / APSYS/
RCOUNT: SIXBIT /DSK/
SIXBIT /COUNT/
XWD 'DMP',14 ;start up COUNT on another job and dont set JLOG
0
SIXBIT / APSYS/
SIXBIT / APSYS/
DOER: SIXBIT /DSK/
SIXBIT /DOER/
XWD 'DMP',14 ;start up DOER on another job and dont set JLOG
0
SIXBIT / APSYS/
SIXBIT / APSYS/
PINITE: 0
.+1
ASCIZ /L AP|SYS
ZONK
RU INITER
/ ;command to PTY to run INITER
SPBPTR: 0
SEQNBR: 0 ;seq number in binary is saved here
SAVEDG: ASCII /
/ ;seq number in ascii is saved here with a crlf
SAVEWD: 0
SAVEDA: 0
TTYLIN: 0
SHIFT: 0 ;flag indicating upper or lower shift characters
LNKSIN: 0 ;flag indicating whether or not LINKS file has been read in
DICREC: 0 ;number of the current dictionary record in core
DYING: -1 ;code sent to HOT to mean FILER is dying
WHOHOT: BLOCK 2
EXCESS: =71
=35
HOTLTR: BLOCK 2 ;header block for sending hot line letters
NAME: SIXBIT /[-AP-]/;job name that FILER will assume
NBRFLR: 0 ;indicator of number of other jobs with filer's name
;Start of main program (FILER).
FILER: SETZ FLG, ;clear all flags
SETZM BUSY
SETZM GODOWN
MOVEI A,INTRPT ;get address of interrupt level module
MOVEM A,JOBAPR ;store it in JOBAPR
MOVE A,[4400200000] ;enable for interrupts on parity errors, receiving
CALL A,[SIXBIT /INTENB/]; mail, and pdl ov
MOVEI A,200000
CALL A,[SIXBIT /INTGEN/];generate a pdl ov interrupt to set the job name
MOVE A,NBRFLR ;get code indicating number of other filers
JRST .+2(A)
ERRMSG {ONE OTHER FILER ALREADY EXISTED WHEN A FILER WAS STARTED UP (0)}
ERRMSG {TWO OR MORE FILERS ALREADY EXISTED WHEN A FILER WAS STARTED UP (1)}
INIT 17,11 ;grab AP news line
SIXBIT /TTY12/
IBUF
ERRMSG {INIT FAILED ON TTY12 (2)}
MOVE A,IBUF+1 ;make byte pointer right size (7 bits--not 36)
TLZ A,7700
TLO A,700
MOVEM A,IBUF+1
MOVE P,[IOWD PDLEN,PDLIST];initialize pdl pointer
MOVE BPTR,[POINT 7,BUF-1,35] ;set up byte ptr to buffer to hold 1st new story
OPEN 0,DSK17 ;prepare to open NEWS file
ERRMSG {OPEN FAILED ON DSK (4)}
SETZM NEWSF+3
LOOKUP 0,NEWSF ;NEWS file
JRST MKNEWS ;no NEWS file exists yet. make one
OUTSTR [ASCIZ / NEWS-EXISTS /]
OPEN 1,DSK17 ;yes. prepare to open INDEX file
ERRMSG {OPEN FAILED ON DSK (6)}
SETZM INDEXF+3
LOOKUP 1,INDEXF ;INDEX file
ERRMSG {STARTING UP: NEWS FILE EXISTS, BUT LOOKUP FAILED ON INDEX FILE (8)}
IN 1,XCMD ;read in index information
JRST .+2
ERRMSG {IN UUO FAILED ON READING IN INDEX FILE (10)}
RELEAS 1, ;INDEX file
MOVE UNDUN,INDEX ;load 3 special pointers into ACs
MOVE NEW,INDEX+1
MOVE OLD,INDEX+2
HLRZ A,INDEX+1(NEW) ;get record number of NEW area
HRRZ B,INDEX+1(NEW) ;get displacement of NEW area
MOVN B,B ;make displacement negative
ASH B,-13 ;right-adjust it
SUB BPTR,B ;set up byte pointer to place for next new story
HRLM B,CMD ;store length for reading/writing last story
HRRM A,.+1 ;put record number in USETI instruction
USETI 0,0-0 ;select record in NEWS file
IN 0,CMD ;read in last part of last story in NEWS file
JRST CONT
ERRMSG {IN UUO FAILED ON READING FROM NEWS FILE (12)}
;Run INITER on a pty.
MKNEWS: RELEAS 0,
PTYGET PINITE ;start up INITER on a PTY
ERRMSG {COULD NOT GET A PTY TO START UP INITER (14)}
MOVEI A,PINITE+2
MOVEM A,PINITE+1
PTWRS7 PINITE
CTRLC: PTRD1W PINITE
MOVE A,PINITE+1 ;read char from pty
CAIE A,136 ;read from pty until ↑
JRST CTRLC
PTRD1W PINITE
MOVE A,PINITE+1
CAIE A,103 ; and C
JRST CTRLC
GETDOT: PTRD1W PINITE
MOVE A,PINITE+1
CAIE A,56 ;read from pty until find period (monitor level)
JRST GETDOT
;Create NEWS and INDEX files.
OPEN 0,DSK17 ;prepare to create new NEWS file
ERRMSG {OPEN FAILED ON DSK (16)}
SETZM NEWSF+1
SETZM NEWSF+2
SETZM NEWSF+3
OUTSTR [ASCIZ / MAKING-NEWS /]
ENTER 0,NEWSF ;create NEWS file
ERRMSG {ENTER FAILED DURING ATTEMPT TO CREATE NEWS FILE (18)}
SETZM BUF ;zero the first word in the story buffer
OUT 0,CMD ;write out 1 zero word in NEWS
JRST .+2
ERRMSG {OUT UUO FAILED DURING ATTEMPT TO INITIALIZE NEWS FILE (19)}
OPEN 1,DSK17 ;prepare to create INDEX file
ERRMSG {OPEN FAILED ON DSK (20)}
SETZM INDEXF+1
SETZM INDEXF+2
SETZM INDEXF+3
ENTER 1,INDEXF ;INDEX file
ERRMSG {ENTER FAILED DURING ATTEMPT TO CREATE INDEX FILE (22)}
MOVEI UNDUN,XSIZE+SPECS;initialize special pointers
MOVEM UNDUN,INDEX
MOVEI NEW,XSIZE+SPECS
MOVEM NEW,INDEX+1
MOVEI OLD,SPECS
MOVEM OLD,INDEX+2
MOVE A,[XWD 1,4000]
MOVEM A,INDEX+1(NEW) ;initialize index information for NEW area
MOVE A,[XWD 10,4000]
MOVEM A,INDEX+1(OLD) ;initialize index information for OLD area
OUT 1,XCMD ;write out INDEX file
JRST .+2
ERRMSG {OUT UUO FAILED DURING ATTEMPT TO WRITE OUT INITIAL INDEX FILE (24)}
ADDI BPTR,1 ;increase byte pointer beyond 1-word short story
INITED: PTRD1W PINITE ;get a char from INITER
MOVE A,PINITE+1
CAIE A,36 ;is char a "≡"?
JRST INITED ;no
PTRD1W PINITE ;yes. get another char
MOVE A,PINITE+1
CAIE A,41 ;is char a "!"?
ERRMSG {INITER DETECTED AN ERROR CONDITION AND DIDN'T FINISH (26)}
PTYREL PINITE ;yes. INITER is done. release its PTY.
RELEAS 1, ;INDEX file after INITER has succeeded
CONT: RELEAS 0,
IN 17,
JRST .+2
ERRMSG {IN UUO FAILED DURING ATTEMPT TO GET FIRST AP BUFFER (30)}
MOVE BCNT,IBUF+2
;Search for beginning of story. Then collect entire story.
GETNEW: MOVE STORY,BPTR ;save byte pointer to beginning of next story
HRRZM BPTR,HOTLTR+1 ;save ptr for sending mail to hot lines
AOS HOTLTR+1 ;(bptr points to word before first word of story)
SETZM 1(BPTR) ;zero out first word of ltr so HOT won't get garbage at end of story
RESTRT: PUSHJ P,GETCH ;get next char
CAIE CHAR,141 ;is char an 'a'?
JRST RESTRT ;no. start over
MOVEI CNT,3 ;yes, prepare to look for 3 digits after the 'a'
MOVE A,[POINT 7,SAVEDG]
MOVEM A,SPBPTR
SETZ AC1, ;AC1 will hold the calculated SEQ NBR
NEXTDG: PUSHJ P,GETCH
CAIG CHAR,"9" ;is character a digit?
CAIGE CHAR,"0"
JRST RESTRT ;character wasn't a digit. start over
IDPB CHAR,SPBPTR ;save sequence number of story
IMULI AC1,=10 ;MULTIPLY OLD SUM BY =10
ADDI AC1,-60(CHAR) ;ADD IN NEW DIGIT
SOJG CNT,NEXTDG ;got all 3 digits?
PUSHJ P,GETCH ;yes. get next char
CAIE CHAR,LF ;is it a LF?
JRST RESTRT ;no. start over
MOVEM AC1,SEQNBR ;SAVE SEQ NBR
SUBI BPTR,1
SETZ A,
MOVEI B,=10
IDPB A,BPTR
SOJG B,.-1
PUSHJ P,SNDHOT
HRRZM BPTR,HOTLTR+1
SOS HOTLTR+1
FINDCR: PUSHJ P,GETCH ;get next char
SETZ A,
DPB A,BPTR
CAIE CHAR,CR ;is it a CR?
JRST FINDCR ;no. keep reading until found CR
PUSHJ P,GETCH
CAIE CHAR,LF
ERRMSG {NO LF FOLLOWING CR AFTER JUNK AT FRONT OF AP STORY (32)}
MOVE BPTR,STORY
ADDI BPTR,1
MOVE A,SAVEDG
MOVEM A,(BPTR)
HRRZM BPTR,HOTLTR+1
MOVEI CNT,2 ;prepare to look for 3 LFs at end of story
NEXTCH: PUSHJ P,GETCH ;get next char
CAIE CHAR,LF ;is char a LF?
MOVEI CNT,3 ;no. reset LF counter
SOJGE CNT,NEXTCH ;if haven't found all 4 LFs, go get more text
;Prepare to write out newly read story.
FNDEND:
SETZM LNKSIN ;set flag to indicate LINKS file hasn't been read in
SETZM DICREC ;indicate that no dictionary record is in core
OUTSTR [ASCIZ / FNDEND /]
DEP0: IDPB FLG,BPTR ;right half of AC FLG is always zero
TLNE BPTR,760000 ;check if at end of word (in story buffer)
JRST DEP0
PUSHJ P,SNDHOT ;send out last part of story to hot lines
HRRZ SIZE,STORY ;compute size (actually negative of size) of story
HRRZ A,BPTR ; by subtracting pointer to last word from
SUB SIZE,A ; pointer to word just before first word
MOVEI TXTLEN,BUF-1 ;check if story ends on record
SUB TXTLEN,A
TRNE TXTLEN,177
JRST NOTREC
SETZM 1(BPTR) ;story ends on record. add one word of zeroes to it
SUBI SIZE,1 ;increase size by 1
ADDI BPTR,1 ;increment byte pointer
SUBI TXTLEN,1 ;increment text length count
NOTREC: HRLM TXTLEN,CMD ;store size of story (negated) in dump mode command
SETOM BUSY# ;turn on BUSY flag
AGAIN2: OPEN 2,DSK17 ;prepare to create new INDEX file
ERRMSG {OPEN FAILED ON DSK (34)}
SETZM INDEXF+1
SETZM INDEXF+2
SETZM INDEXF+3
ENTER 2,INDEXF ;create new INDEX file
JRST [RELEAS 2,
OUTSTR [ASCIZ / PAUSE-INDEX /]
MOVEI A,1
CALL A,[SIXBIT /SLEEP/]
JRST AGAIN2]
OPEN 1,DSK17 ;prepare to open INDEX file
ERRMSG {OPEN FAILED ON DSK (36)}
SETZM INDEXF+3
LOOKUP 1,INDEXF ;INDEX file
ERRMSG {LOOKUP FAILED ON INDEX FILE (38)}
IN 1,XCMD ;read in entire INDEX file
JRST .+2
ERRMSG {IN UUO FAILED DURING ATTEMPT TO READ IN INDEX FILE (40)}
RELEAS 1, ;old INDEX file (now secretly goes away)
MOVE UNDUN,INDEX ;move special pointers into ACs
MOVE NEW,INDEX+1
MOVE OLD,INDEX+2
MOVE FST,INDEX+1(NEW);get pointer to beginning of area for NEW story
MOVE NXT,FST
ASH SIZE,13 ;move size left to correct field
SUB NXT,SIZE ;calculate first word beyond end of story in NEWS
;See how many (if any) old stories must be deleted to fit the new story in.
TRY: CAMLE FST,INDEX+1(OLD);check if NEW is below OLD (thus at bottom)
JRST ATBOTM
CAMG NXT,INDEX+1(OLD);check if NEW story runs over OLD story
JRST INSERT ;it doesn't. write it out
PUSHJ P,DELOLD ;it does. delete an OLD story
JRST TRY
ATBOTM: CAMG NXT,[XWD RECLMT,0];does new story fit in allowable file size?
JRST INSERT ;yes. write it out
MOVEI A,SPL
CALL A,[SIXBIT /SWAP/] ;run SPL on another job
MOVEI A,RCOUNT
CALL A,[SIXBIT /SWAP/] ;run COUNT on another job
MOVEM FST,INDEX+3 ;no. store ptr to bottom of the NEWS file
MOVN NXT,TXTLEN ;prepare to put new story at front of NEWS file
ADDI NXT,200
ASH NXT,13
MOVE FST,SIZE
ADD FST,NXT
MOVEM FST,INDEX+1(NEW)
NEXT: CAMG NXT,INDEX+1(OLD);check if NEW story runs over OLD one
JRST INSERT ;it fits. write it out
PUSHJ P,DELOLD ;it doesn't fit. delete one OLD story
JRST NEXT
;Update INDEX file.
INSERT: MOVE A,SEQNBR ;retrieve seq nbr
MOVEM A,INDEX+2(NEW) ;put the seq nbr into INDEX entry for this story
ADDI NEW,XSIZE ;get index pointer for next NEW area
CAIL NEW,XLEN
MOVEI NEW,SPECS
CAMN NEW,OLD ;is NEW index area same as OLD index area?
PUSHJ P,DELOLD ;yes, as usual, delete one OLD story
MOVEM NXT,INDEX+1(NEW);store rec nbr/displ in new NEW index entry
HLLZ NXT,NXT ;zero out displacement part of pointer (leaving only rec.nbr.)
INS2: HLLZ A,INDEX+1(OLD) ;get number of record in which OLD story begins
CAME NXT,A ;see if new story ends in this same record
JRST INS1 ;it doesn't
PUSHJ P,DELOLD ;it does. delete one OLD story and
JRST INS2 ; check next OLD story
INS1: SKIPE DICREC ;has any of the dictionary been read in?
OUT 3,DCMD ;yes. write out the new version of the record in core
JRST .+2
ERRMSG {OUT UUO FAILED DURING ATTEMPT TO WRITE OUT FINAL IN CORE RECORD OF FILE: DICT (41)}
SKIPN LNKSIN ;has the LINKS file been read in?
JRST NOLNKS ;no
OPEN 4,DSK17 ;yes. write out the new version of LINKS
ERRMSG {OPEN FAILED ON DSK (42)}
SETZM LINKSF+1
SETZM LINKSF+2
SETZM LINKSF+3
ENTER 4,LINKSF
ERRMSG {ENTER FAILED ON LINKS FILE (44)}
OUT 4,LCMD
JRST .+2
ERRMSG {OUT UUO FAILED DURING ATTEMPT TO WRITE OUT LINKS FILE (46)}
RELEAS 4, ;new LINKS file
NOLNKS: RELEAS 3, ;new DICT file
MOVEM NEW,INDEX+1 ;put special pointers back into index array
MOVEM OLD,INDEX+2
OUT 2,XCMD ;write out index information
JRST .+2
ERRMSG {OUT UUO FAILED DURING ATTEMPT TO WRITE OUT INDEX FILE (48)}
;Write out new story.
AGAIN1: OPEN 0,DSK17 ;prepare to open NEWS file
ERRMSG {OPEN FAILED ON DSK (50)}
SETZM NEWSF+3
LOOKUP 0,NEWSF ;NEWS file (open sesame)
ERRMSG {LOOKUP FAILED ON NEWS FILE (52)}
SETZM NEWSF+3
ENTER 0,NEWSF ;NEWS file again (open for updating)
JRST [RELEAS 0,
OUTSTR [ASCIZ / PAUSE-NEWS /]
MOVEI A,1
CALL A,[SIXBIT /SLEEP/]
JRST AGAIN1]
HLRM FST,.+1 ;store record number in USETO instr.
USETO 0.0-0 ;select appropriate record for writing out new story
OUT 0,CMD ;write it out!
JRST .+2
ERRMSG {OUT UUO FAILED DURING ATTEMPT TO WRITE OUT STORY ON NEWS FILE (54)}
RELEAS 2,
RELEAS 0, ;close updated NEWS file
MOVE A,[SIXBIT /[DOER]/];see if a DOER job exists
CALL A,[SIXBIT /NAMEIN/]
JRST .+2 ;either no or multiple DOERs exist
JRST F1 ;exactly one DOER exists--nothing to do
MOVEI B,DOER ;prepare to start up DOER if no DOER exists
CAIN A,1 ;do multiple DOERs exist?
CALL B,[SIXBIT /SWAP/];no. start up DOER
;move last record of text in story buffer to top of buffer
F1:
SETZM BUSY
SKIPE GODOWN ;should we go away now?
JRST GOAWAY ;yes
MOVN TXTLEN,TXTLEN ;no
TRZ TXTLEN,177
CAIN TXTLEN,0
JRST GETNEW
SUB BPTR,TXTLEN
MOVEI A,BUF
HRLI A,BUF(TXTLEN)
BLT A,(BPTR)
JRST GETNEW ;get next AP story
;Subroutines: ERROR.
ERROR: SETOM TTYLIN
GETLIN TTYLIN
AOSN TTYLIN
JRST ADDERR ;job is detached so put message into a file
OUTSTR [CRLFS: ASCIZ /
/]
OUTSTR (A) ;job not detached, so print out message
OUTSTR CRLFS
MOVE A,SAVEDA
CALLI 1,12 ;EXIT, inhibit closing files
HALT .
ADDERR: CALLI 0 ;RESET
MOVEI B,1
MOVEI CNT,10
AGAINE: INIT 1,0
SIXBIT /DSK/
XWD ERRBFO,0
HALT .-3
SETZM ERRORF+1
SETZM ERRORF+2
SETZM ERRORF+3
ENTER 1,ERRORF
JRST [RELEAS 1,
SOJLE CNT,SPLIT
CALL B,[SIXBIT /SLEEP/]
JRST AGAINE]
INIT 2,0
SIXBIT /DSK/
ERRBFI
HALT .-3
SETZM ERRORF+3
LOOKUP 2,ERRORF
JRST COPIED
COPYER: SOSG ERRBFI+2
IN 2,
JRST [ILDB CHAR,ERRBFI+1
JUMPE CHAR,COPIED
SOSG ERRBFO+2
OUT 1,
JRST [IDPB CHAR,ERRBFO+1
JRST COPYER]
FOO: HALT FOO]
STATO 2,20000
HALT .
;Subroutines: ERROR (cont'd).
COPIED: RELEAS 2,
CALL B,[SIXBIT /DATE/]
CALL C,[SIXBIT /TIMER/]
IDIVI C,=60*=3600
IDIVI C+1,=3600
IDIVI C+1,=10
HRLZI AC1,40B24 ;put a blank in AC1
ADDI AC1,60(C+2) ;ONES PLACE OF MINUTES
ROT AC1,-7
ADDI AC1,60(C+1) ;TENS PLACE OF MINUTES
ROT AC1,-7
IDIVI C,=10
ADDI AC1,60(C+1) ;ONES PLACE OF HOURS
ROT AC1,-7
ADDI AC1,60(C) ;TENS PLACE OF HOURS
ROT AC1,-7
IDIVI B,=31
ADDI B+1,1
IDIVI B+1,=10
MOVEI AC2,60(B+2) ;ONES PLACE OF DAY
ROT AC2,-7
ADDI AC2,60(B+1) ;TENS PLACE OF DAY
ROT AC2,-16
ADD AC2,[ASCII /-/] ;PUT "-" BETWEEN MONTH AND DAY
IDIVI B,=12
ADDI B+1,1
IDIVI B+1,=10
ADDI AC2,60(B+2) ;ONES PLACE OF MONTH
ROT AC2,-7
ADDI AC2,60(B+1) ;TENS PLACE OF MONTH
ROT AC2,-7
MOVE BPTR,[POINT 7,AC1]
MOVEI CNT,=10 ;put 10 chars into output buffer
DAYTIM: ILDB CHAR,BPTR ;output the time, month, and day
SOSG ERRBFO+2
OUT 1,
JRST [IDPB CHAR,ERRBFO+1
SOJG CNT,DAYTIM
JRST ADDMSG]
HALT .
ADDMSG: HRLI A,440700 ;output error message
MESSAG: ILDB CHAR,A
SOSG ERRBFO+2
OUT 1,
JRST [IDPB CHAR,ERRBFO+1
JUMPN CHAR,MESSAG
JRST CLOSEM]
HALT .
CLOSEM: RELEAS 1,
SPLIT:
MOVEI A,DYING
MOVEM A,HOTLTR+1
PUSHJ P,SNDHOT
CALLI 12 ;EXIT
;Subroutines: GETCH,CHGNAM,INTRPT.
GETCH: SOJGE BCNT,LOADCH ;any chars in AP buffer?
MOVE A,(BPTR)
MOVEM A,SAVEWD
SETZM (BPTR)
PUSHJ P,SNDHOT
HRRZM BPTR,HOTLTR+1
MOVE A,SAVEWD
MOVEM A,(BPTR)
IN 17, ;no. get some more
JRST .+2
ERRMSG {IN UUO FAILED WHEN READING FROM TTY12 (56)}
HRRZ A,BPTR
CAIL A,BUF+BLEN-200
JRST [CALLI 0
MOVEI A,DYING
MOVEM A,HOTLTR+1
PUSHJ P,SNDHOT
CALLI 12] ;EXIT;ERRMSG{STORY BUFFER OVERFLOW}
MOVE BCNT,IBUF+2 ;get byte count
SOJL BCNT,GETCH+1 ;decrement byte count
LOADCH: ILDB CHAR,IBUF+1 ;get a char
TRZE CHAR,100 ;check and mask out 100 bit of incoming AP char
ERRMSG {100 BIT OF AP CHAR WAS ON}
ADD CHAR,SHIFT ;SHIFT contains either 100 (octal) or zero
XCT CONVRT(CHAR)
CHAROK:
; JUMPE CHAR,GETCH ;ignore null bytes
IDPB CHAR,BPTR
POPJ P, ;return
;interrupt level module
INTRPT: MOVE A,JOBCNI ;get bit causing interrupt
JFFO A,.+1
CAIN A+1,6 ;did a letter come in?
JRST PROCRQ ;yes. process it
CAIN A+1,=19 ;is this interrupt to set filer's job name?
JRST CHGNAM ;yes. do it
HRLZI C,400 ;disable for all but parity error interrupts
CALL C,[SIXBIT /INTENB/]
MOVEM A+1,SVINTR# ;save indicator of the cause of the interrupt
CALL [SIXBIT /UWAIT/]
JRST@ 2,[.+1] ;get out of user-iot
CALL [SIXBIT /DEBREAK/]
MOVE A,SVINTR
CAIE A,=9 ;was this interrupt for a parity error?
ERRMSG {UNKNOWN INTERRUPT OCCURRED IN FILER} ;no!
ERRMSG {PARITY ERROR IN FILER} ;yes
;interrupt level routine to set the job name
CHGNAM: SETZ A, ;zero out own job name
CALL A,[SIXBIT /SETNAM/]
SETOM NBRFLR ;initialize indicator to one other filer
MOVE A,NAME
CALL A,[SIXBIT /NAMEIN/]
JRST .+2 ;zero or multiple filers exist
CALL [SIXBIT /DISMIS/] ;one other filer exists
SETZM NBRFLR ;set indicator to multiple filers
CAIE A,1 ;check error code of NAMEIN
CALL [SIXBIT /DISMIS/] ;two or more other filers exist
AOS NBRFLR ;set indicator to no other filers
MOVE A,NAME ;change job name
CALL A,[SIXBIT /SETNAM/]
MOVEI A,200000
CALL A,[SIXBIT /INTACM/] ;disable for further pdl ov interrupts
CALL [SIXBIT /DISMIS/]
;Subroutines: DELOLD.
DELOLD: HLRZ SLOT,INDEX(OLD) ;get the back ptr from the index entry of OLD
OUTSTR [ASCIZ / DELOLD /]
JUMPE SLOT,DEL5 ;if the back ptr is null, there are no slots to free up
SKIPE LNKSIN ;has LINKS been read in already for this story?
JRST DEL0 ;yes.
SETOM LNKSIN ;no. set flag to indicate it has now and
OPEN 4,DSK17 ; read in LINKS
ERRMSG {DELOLD: OPEN FAILED ON DSK (56)}
SETZM LINKSF+3
LOOKUP 4,LINKSF
ERRMSG {DELOLD: LOOKUP FAILED ON LINKS FILE (58)}
IN 4,LCMD
JRST .+2
ERRMSG {DELOLD: IN UUO FAILED DURING ATTEMPT TO READ IN LINKS FILE (60)}
RELEAS 4,
DEL0: HRRZ C,LINKS+1(SLOT) ;has this link already been freed up?
JUMPE C,DEL5 ; (zero means yes)
DEL1: HLRZ A,LINKS(SLOT) ;get forward ptr to same word, different story
HRRE B,LINKS(SLOT) ;get back ptr to same word, different story
JUMPE A,DEL2 ;is forward ptr null?
HRRM B,LINKS(A) ;no. store new back ptr in slot specified by forward ptr
DEL2: JUMPL B,DEL3 ;does back ptr point into dictionary?
HRLM A,LINKS(B) ;no. store new forward ptr in slot specified by back ptr
JRST DEL4
DEL3: MOVN B,B ;back ptr points into dictionary. make the ptr positive
MOVE C,B
ASH C,-7 ;get the part of the dict ptr indicating the dict record
ADDI C,1
CAMN C,DICREC ;is the correct dictionary record already in core?
JRST DEL6 ;yes
SKIPE DICREC ;no. is any record in core?
JRST DEL7 ;yes
AGAIN3: OPEN 3,DSK17 ;no. open the DICT file in Read Alter mode
ERRMSG {OPEN FAILED ON DSK (62)}
SETZM DICTF+3
LOOKUP 3,DICTF
JRST [PAUSE3: RELEAS 3,
OUTSTR [ASCIZ / PAUSE-DICT /]
MOVEI D,1
CALL D,[SIXBIT /SLEEP/]
JRST AGAIN3]
SETZM DICTF+3
ENTER 3,DICTF
JRST PAUSE3
JRST DEL8
DEL7: OUT 3,DCMD ;write out the record that is in core
JRST .+2
ERRMSG {DELOLD: OUT UUO FAILED DURING ATTEMPT TO WRITE OUT RECORD OF DICT FILE (64)}
DEL8: MOVEM C,DICREC ;save the number of the new record being read in
USETI 3,(C) ;select the record needed in core
IN 3,DCMD ;read in the new record
JRST .+2
ERRMSG {DELOLD: IN UUO FAILED DURING ATTEMPT TO READ IN RECORD OF DICT FILE (66)}
USETO 3,(C) ;select the same record for writing it back out later
DEL6: TRZ B,777600 ;mask out all but the displ of the address of the dict entry
HRRM A,DICT+1(B) ;store, in the dictionary entry, a new ptr into LINKS
DEL4: MOVE A,LINKS ;return the slot being deleted to the
MOVEM A,LINKS(SLOT) ; free slot list
MOVEM SLOT,LINKS ;update the header for the free slot list
HLLZS LINKS+1(SLOT) ;zero field to indicate links have been fixed
HLRZ SLOT,LINKS+1(SLOT);get the ptr to the next word (slot) for the same story
JUMPN SLOT,DEL1 ;if it's not null, go back and delete that slot
DEL5: SETZM INDEX(OLD) ;clear back ptr and link of OLD INDEX entry
SETZM INDEX+2(OLD) ;clear seq nbr of OLD INDEX entry
ADDI OLD,XSIZE ;adjust OLD to the next INDEX entry
CAIL OLD,XLEN
MOVEI OLD,SPECS
POPJ P,
;Subroutines: SNDHOT,PROCRQ,GOAWAY.
;process a request for the hot line
PROCRQ:
; OUTSTR [ASCIZ /INT /]
SKIPE GODOWN
CALLI 400024 ;DISMIS
JRST@ 2,[.+1] ;get out of USER-IOT mode
WRCV INLTR
; OUTSTR [ASCIZ /LTR /]
MOVE A,INLTR
CAME A,[SIXBIT /HOT/];did letter come from HOT?
JRST NOTHOT ;no
OUTSTR [ASCIZ /HOTRQ /]
MOVEI E,1 ;yes
MOVE A,INLTR+1 ;get job number of job requesting hot line
JUMPLE A,NOJBNO ;make sure job nbr is positive
CAILE A,=35
SETZ E, ;if job number is greater than 35, then its bit is in 1st word
CAILE A,=71 ;make sure job nbr is less than 72
JRST NOJBNO ;job number is too big
MOVEI C,1 ;turn on the low order bit of AC
ROT C,(A) ;rotate bit into correct position
IORM C,WHOHOT(E) ;turn on hot line bit for job sending request
NOJBNO: CALLI 400024 ;DISMIS
NOTHOT: CAME A,[ASCII /ZONK /]
CALLI 400024 ;DISMIS
SETOM GODOWN#
SKIPE BUSY ;can we quit now?
CALLI 400024 ;no. DISMIS
CALLI 400034 ;yes. UWAIT.
CALLI 400035 ;DEBREAK
GOAWAY: CALLI 0 ;RESET
MOVEI A,INLTR+1
MOVEM A,HOTLTR+1
PUSHJ P,SNDHOT ;send message to HOT users
ERRMSG {MANUAL DEATH!}
;send out latest buffer to all hot line users
SNDHOT: SKIPN @HOTLTR+1 ;if letter to be sent starts out with a word
POPJ P, ; of zeroes, there is no use sending it
MOVEI E,1
HOT4: MOVE A,WHOHOT(E)
JRST HOT1
HOT2: SUB A+1,EXCESS(E)
MOVN A+1,A+1
MOVEM A+1,HOTLTR ;store job number of addressee of hot line letter
MOVEI C,1
ROT C,(A+1) ;rotate to the bit for this job
MAIL 5,HOTLTR ;send the hot line letter
JRST TRY2ND
JRST HOT3
REMHOT: ANDCAM C,WHOHOT(E) ;failed to send mail. remove jobnbr from mailing list
HOT3: ANDCM A,C ;turn off this guy's bit in the AC (A)
HOT1: JFFO A,HOT2
SOJGE E,HOT4
POPJ P,
TRY2ND: MOVEI B,1 ;failed to send mail on first try. try a 2nd time.
CALL B,[SIXBIT /SLEEP/]
MAIL 5,HOTLTR
JRST TRY3RD
JRST HOT3
JRST REMHOT
TRY3RD: CALL B,[SIXBIT /SLEEP/];failed to send mail twice. try a 3rd time (last chance)
MAIL 5,HOTLTR
JRST REMHOT
JRST HOT3
JRST REMHOT
;Conversion table for unshifted characters. Setting and clearing shift flag (SHFTFG).
SETSHF: MOVEI CHAR,100
MOVEM CHAR,SHIFT
JRST GETCH
CLRSHF: SETZM SHIFT
JRST GETCH
CONVRT: JRST GETCH ;0: tape feed
MOVEI CHAR,"e" ;1
MOVEI CHAR,LF ;2: elevate→line feed
MOVEI CHAR,"a" ;3
JRST CKPARA ;4: space. make into 4 spaces if after LF
MOVEI CHAR,"s" ;5
MOVEI CHAR,"i" ;6
MOVEI CHAR,"u" ;7
MOVEI CHAR,CR ;10: carriage return
MOVEI CHAR,"d" ;11
MOVEI CHAR,"r" ;12
MOVEI CHAR,"j" ;13
MOVEI CHAR,"n" ;14
MOVEI CHAR,"f" ;15
MOVEI CHAR,"c" ;16
MOVEI CHAR,"k" ;17
MOVEI CHAR,"t" ;20
MOVEI CHAR,"z" ;21
MOVEI CHAR,"l" ;22
MOVEI CHAR,"w" ;23
MOVEI CHAR,"h" ;24
MOVEI CHAR,"y" ;25
MOVEI CHAR,"p" ;26
MOVEI CHAR,"q" ;27
MOVEI CHAR,"o" ;30
MOVEI CHAR,"b" ;31
MOVEI CHAR,"g" ;32
JRST SETSHF ;33: shift
MOVEI CHAR,"m" ;34
MOVEI CHAR,"x" ;35
MOVEI CHAR,"v" ;36
JRST CLRSHF ;37: unshift
JRST CKPARA ;40: thin space→space
MOVEI CHAR,"3" ;41
MOVEI CHAR,LF ;42: paper feed→line feed
MOVEI CHAR,"$" ;43
JRST CKPARA ;44: add thin space→space
JRST CKPARA ;45: em space→space
MOVEI CHAR,"8" ;46
MOVEI CHAR,"7" ;47
MOVEI CHAR,"'" ;50
MOVEI CHAR,"-" ;51
MOVEI CHAR,"4" ;52
JRST GETCH ;53: bell
MOVEI CHAR,"," ;54: comma
JRST GETCH ;55: undefined
JRST CKPARA ;56: en space→space
JRST GETCH ;57: quad right
MOVEI CHAR,"5" ;60
MOVEI CHAR,")" ;61
JRST CKPARA ;62: em space→space
MOVEI CHAR,"2" ;63
JRST GETCH ;64: em leader
MOVEI CHAR,"6" ;65
MOVEI CHAR,"0" ;66
JRST GETCH ;67: en leader
MOVEI CHAR,"9" ;70
JRST GETCH ;71: upper rail
MOVEI CHAR,";" ;72
JRST GETCH ;73: lower rail
MOVEI CHAR,"." ;74: period
MOVEI CHAR,"1" ;75
JRST GETCH ;76: undefined
JRST GETCH ;77: rub out
UPPER: JRST GETCH ;0: tape feed
MOVEI CHAR,"E" ;1
MOVEI CHAR,LF ;2: elevate→line feed
MOVEI CHAR,"A" ;3
JRST CKPARA ;4: space. make into 4 spaces if after LF
MOVEI CHAR,"S" ;5
MOVEI CHAR,"I" ;6
MOVEI CHAR,"U" ;7
MOVEI CHAR,CR ;10: carriage return
MOVEI CHAR,"D" ;11
MOVEI CHAR,"R" ;12
MOVEI CHAR,"J" ;13
MOVEI CHAR,"N" ;14
MOVEI CHAR,"F" ;15
MOVEI CHAR,"C" ;16
MOVEI CHAR,"K" ;17
MOVEI CHAR,"T" ;20
MOVEI CHAR,"Z" ;21
MOVEI CHAR,"L" ;22
MOVEI CHAR,"W" ;23
MOVEI CHAR,"H" ;24
MOVEI CHAR,"Y" ;25
MOVEI CHAR,"P" ;26
MOVEI CHAR,"Q" ;27
MOVEI CHAR,"O" ;30
MOVEI CHAR,"B" ;31
MOVEI CHAR,"G" ;32
JRST SETSHF ;33: shift
MOVEI CHAR,"M" ;34
MOVEI CHAR,"X" ;35
MOVEI CHAR,"V" ;36
JRST CLRSHF ;37: unshift
JRST CKPARA ;40: thin space→space
JRST SPE3 ;41: 3/8
MOVEI CHAR,LF ;42: paper feed→line feed
MOVEI CHAR,"!" ;43
JRST CKPARA ;44: add thin space→space
JRST CKPARA ;45: em space→space
MOVEI CHAR,"-" ;46
JRST SPE7 ;47: 7/8
MOVEI CHAR,"'" ;50: left quote→right quote (ttys dont have left quote)
MOVEI CHAR,"+" ;51
JRST SPE4 ;52: 1/2
JRST GETCH ;53: bell
MOVEI CHAR,"," ;54: comma
JRST GETCH ;55: undefined
JRST CKPARA ;56: en space→space
JRST GETCH ;57: quad right
JRST SPE5 ;60: 5/8
MOVEI CHAR,"(" ;61
JRST CKPARA ;62: em space→space
JRST SPE2 ;63: 1/4
JRST GETCH ;64: em leader
JRST SPE6 ;65: 3/4
MOVEI CHAR,"?" ;66
JRST GETCH ;67: en leader
MOVEI CHAR,"&" ;70
JRST GETCH ;71: upper rail
MOVEI CHAR,":" ;72
JRST GETCH ;73: lower rail
MOVEI CHAR,"." ;74: period
JRST SPE1 ;75: 1/8
JRST GETCH ;76: undefined
JRST GETCH ;77: rub out
;Conversion code for special characters.
SPE1: MOVEI CHAR," "
IDPB CHAR,BPTR
MOVEI CHAR,"1" ;1/8
IDPB CHAR,BPTR
MOVEI CHAR,"/"
IDPB CHAR,BPTR
MOVEI CHAR,"8"
IDPB CHAR,BPTR
POPJ P,
SPE2: MOVEI CHAR," "
IDPB CHAR,BPTR
MOVEI CHAR,"1" ;1/4
IDPB CHAR,BPTR
MOVEI CHAR,"/"
IDPB CHAR,BPTR
MOVEI CHAR,"4"
IDPB CHAR,BPTR
POPJ P,
SPE3: MOVEI CHAR," "
IDPB CHAR,BPTR
MOVEI CHAR,"3" ;3/8
IDPB CHAR,BPTR
MOVEI CHAR,"/"
IDPB CHAR,BPTR
MOVEI CHAR,"8"
IDPB CHAR,BPTR
POPJ P,
SPE4: MOVEI CHAR," "
IDPB CHAR,BPTR
MOVEI CHAR,"1" ;1/2
IDPB CHAR,BPTR
MOVEI CHAR,"/"
IDPB CHAR,BPTR
MOVEI CHAR,"2"
IDPB CHAR,BPTR
POPJ P,
SPE5: MOVEI CHAR," "
IDPB CHAR,BPTR
MOVEI CHAR,"5" ;5/8
IDPB CHAR,BPTR
MOVEI CHAR,"/"
IDPB CHAR,BPTR
MOVEI CHAR,"8"
IDPB CHAR,BPTR
POPJ P,
SPE6: MOVEI CHAR," "
IDPB CHAR,BPTR
MOVEI CHAR,"3" ;3/4
IDPB CHAR,BPTR
MOVEI CHAR,"/"
IDPB CHAR,BPTR
MOVEI CHAR,"4"
IDPB CHAR,BPTR
POPJ P,
SPE7: MOVEI CHAR," "
IDPB CHAR,BPTR
MOVEI CHAR,"7" ;7/8
IDPB CHAR,BPTR
MOVEI CHAR,"/"
IDPB CHAR,BPTR
MOVEI CHAR,"8"
IDPB CHAR,BPTR
POPJ P,
CKPARA: MOVEI CHAR," "
IDPB CHAR,BPTR ;deposit at least 1 space
CAIE CNT,1 ;if the previous char was a LF, CNT will be 1
POPJ P, ;not after LF
IDPB CHAR,BPTR ;after lf: make space into 4 spaces
IDPB CHAR,BPTR
IDPB CHAR,BPTR
POPJ P,
END FILER